home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / mint / editors / mntemacs.zoo / src / environ.c < prev    next >
C/C++ Source or Header  |  1991-12-02  |  8KB  |  318 lines
  1. /* Environment-hacking for GNU Emacs subprocess
  2.    Copyright (C) 1986 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23.  
  24. #ifdef MAINTAIN_ENVIRONMENT
  25.  
  26. #ifdef VMS
  27. you lose -- this is un*x-only
  28. #endif
  29.  
  30. /* alist of (name-string . value-string) */
  31. Lisp_Object Venvironment_alist;
  32. extern char **environ;
  33.  
  34. void
  35. set_environment_alist (str, val)
  36.      register Lisp_Object str, val;
  37. {
  38.   register Lisp_Object tem;
  39.  
  40.   tem = Fassoc (str, Venvironment_alist);
  41.   if (NULL (tem))
  42.     if (NULL (val))
  43.       ;
  44.     else
  45.       Venvironment_alist = Fcons (Fcons (str, val), Venvironment_alist);
  46.   else
  47.     if (NULL (val))
  48.       Venvironment_alist = Fdelq (tem, Venvironment_alist);
  49.     else
  50.       XCONS (tem)->cdr = val;
  51. }
  52.  
  53.  
  54.  
  55. static void
  56. initialize_environment_alist ()
  57. {
  58.   register unsigned char **e, *s;
  59.   extern char *index ();
  60.  
  61.   for (e = (unsigned char **) environ; *e; e++)
  62.     {
  63.       s = (unsigned char *) index (*e, '=');
  64.       if (s)
  65.     set_environment_alist (make_string (*e, s - *e),
  66.                    build_string (s + 1));
  67.     }
  68. }
  69.  
  70.  
  71. unsigned char *
  72. getenv_1 (str, ephemeral)
  73.      register unsigned char *str;
  74.      int ephemeral;        /* if ephmeral, don't need to gc-proof */
  75. {
  76.   register Lisp_Object env;
  77.   int len = strlen (str);
  78.  
  79.   for (env = Venvironment_alist; CONSP (env); env = XCONS (env)->cdr)
  80.     {
  81.       register Lisp_Object car = XCONS (env)->car;
  82.       register Lisp_Object tem = XCONS (car)->car;
  83.  
  84.       if ((len == XSTRING (tem)->size) &&
  85.       (!bcmp (str, XSTRING (tem)->data, len)))
  86.     {
  87.       /* Found it in the lisp environment */
  88.       tem = XCONS (car)->cdr;
  89.       if (ephemeral)
  90.         /* Caller promises that gc won't make him lose */
  91.         return XSTRING (tem)->data;
  92.       else
  93.         {
  94.           register unsigned char **e;
  95.           unsigned char *s;
  96.           int ll = XSTRING (tem)->size;
  97.  
  98.           /* Look for element in the original unix environment */
  99.           for (e = (unsigned char **) environ; *e; e++)
  100.         if (!bcmp (str, *e, len) && *(*e + len) == '=')
  101.           {
  102.             s = *e + len + 1;
  103.             if (strlen (s) >= ll)
  104.               /* User hasn't either hasn't munged it or has set it
  105.              to something shorter -- we don't have to cons */
  106.               goto copy;
  107.             else
  108.               goto cons;
  109.           };
  110.         cons:
  111.           /* User has setenv'ed it to a diferent value, and our caller
  112.          isn't guaranteeing that he won't stash it away somewhere.
  113.          We can't just return a pointer to the lisp string, as that
  114.          will be corrupted when gc happens.  So, we cons (in such
  115.          a way that it can't be freed -- though this isn't such a
  116.          problem since the only callers of getenv (as opposed to
  117.          those of egetenv) are very early, before the user -could-
  118.          have frobbed the environment. */
  119.           s = (unsigned char *) xmalloc (ll + 1);
  120.         copy:
  121.           bcopy (XSTRING (tem)->data, s, ll + 1);
  122.           return (s);
  123.         }
  124.     }
  125.     }
  126.   return ((unsigned char *) 0);
  127. }
  128.  
  129. /* unsigned  -- stupid delcaration in lisp.h */ char *
  130. getenv (str)
  131.      register unsigned char *str;
  132. {
  133.   return ((char *) getenv_1 (str, 0));
  134. }
  135.  
  136. unsigned char *
  137. egetenv (str)
  138.      register unsigned char *str;
  139. {
  140.   return (getenv_1 (str, 1));
  141. }
  142.  
  143.  
  144. #if (1 == 1) /* use caller-alloca versions, rather than callee-malloc */
  145. int
  146. size_of_current_environ ()
  147. {
  148.   register int size;
  149.   Lisp_Object tem;
  150.  
  151.   tem = Flength (Venvironment_alist);
  152.   
  153.   size = (XINT (tem) + 1) * sizeof (unsigned char *);
  154.   /* + 1 for environment-terminating 0 */
  155.  
  156.   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
  157.     {
  158.       register Lisp_Object str, val;
  159.  
  160.       str = XCONS (XCONS (tem)->car)->car;
  161.       val = XCONS (XCONS (tem)->car)->cdr;
  162.  
  163.       size += (XSTRING (str)->size +
  164.            XSTRING (val)->size +
  165.            2);    /* 1 for '=', 1 for '\000' */
  166.     }
  167.   return size;
  168. }
  169.  
  170. void
  171. get_current_environ (memory_block)
  172.      unsigned char **memory_block;
  173. {
  174.   register unsigned char **e, *s;
  175.   register int len;
  176.   register Lisp_Object tem;
  177.  
  178.   e = memory_block;
  179.  
  180.   tem = Flength (Venvironment_alist);
  181.   
  182.   s = (unsigned char *) memory_block
  183.         + (XINT (tem) + 1) * sizeof (unsigned char *);
  184.  
  185.   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
  186.     {
  187.       register Lisp_Object str, val;
  188.  
  189.       str = XCONS (XCONS (tem)->car)->car;
  190.       val = XCONS (XCONS (tem)->car)->cdr;
  191.  
  192.       *e++ = s;
  193.       len = XSTRING (str)->size;
  194.       bcopy (XSTRING (str)->data, s, len);
  195.       s += len;
  196.       *s++ = '=';
  197.       len = XSTRING (val)->size;
  198.       bcopy (XSTRING (val)->data, s, len);
  199.       s += len;
  200.       *s++ = '\000';
  201.     }
  202.   *e = 0;
  203. }
  204.  
  205. #else
  206. /* dead code (this function mallocs, caller frees) superseded by above (which allows caller to use alloca) */
  207. unsigned char **
  208. current_environ ()
  209. {
  210.   unsigned char **env;
  211.   register unsigned char **e, *s;
  212.   register int len, env_len;
  213.   Lisp_Object tem;
  214.   Lisp_Object str, val;
  215.  
  216.   tem = Flength (Venvironment_alist);
  217.  
  218.   env_len = (XINT (tem) + 1) * sizeof (char *);
  219.   /* + 1 for terminating 0 */
  220.  
  221.   len = 0;
  222.   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
  223.     {
  224.       str = XCONS (XCONS (tem)->car)->car;
  225.       val = XCONS (XCONS (tem)->car)->cdr;
  226.  
  227.       len += (XSTRING (str)->size +
  228.           XSTRING (val)->size +
  229.           2);
  230.     }
  231.  
  232.   e = env = (unsigned char **) xmalloc (env_len + len);
  233.   s = (unsigned char *) env + env_len;
  234.  
  235.   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
  236.     {
  237.       str = XCONS (XCONS (tem)->car)->car;
  238.       val = XCONS (XCONS (tem)->car)->cdr;
  239.  
  240.       *e++ = s;
  241.       len = XSTRING (str)->size;
  242.       bcopy (XSTRING (str)->data, s, len);
  243.       s += len;
  244.       *s++ = '=';
  245.       len = XSTRING (val)->size;
  246.       bcopy (XSTRING (val)->data, s, len);
  247.       s += len;
  248.       *s++ = '\000';
  249.     }
  250.   *e = 0;
  251.  
  252.   return env;
  253. }
  254.  
  255. #endif /* dead code */
  256.  
  257.  
  258. DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np",
  259.   "Return the value of environment variable VAR, as a string.\n\
  260. When invoked interactively, print the value in the echo area.\n\
  261. VAR is a string, the name of the variable,\n\
  262.  or the symbol t, meaning to return an alist representing the\n\
  263.  current environment.")
  264.   (str, interactivep)
  265.      Lisp_Object str, interactivep;
  266. {
  267.   Lisp_Object val;
  268.   
  269.   if (str == Qt)        /* If arg is t, return whole environment */
  270.     return (Fcopy_alist (Venvironment_alist));
  271.  
  272.   CHECK_STRING (str, 0);
  273.   val = Fcdr (Fassoc (str, Venvironment_alist));
  274.   if (!NULL (interactivep))
  275.     {
  276.       if (NULL (val))
  277.     message ("%s not defined in environment", XSTRING (str)->data);
  278.       else
  279.     message ("\"%s\"", XSTRING (val)->data);
  280.     }
  281.   return val;
  282. }
  283.  
  284. DEFUN ("setenv", Fsetenv, Ssetenv, 1, 2,
  285.   "sEnvironment variable: \nsSet %s to value: ",
  286.   "Return the value of environment variable VAR, as a string.\n\
  287. When invoked interactively, print the value in the echo area.\n\
  288. VAR is a string, the name of the variable.")
  289.   (str, val)
  290.      Lisp_Object str;
  291.      Lisp_Object val;
  292. {
  293.   Lisp_Object tem;
  294.  
  295.   CHECK_STRING (str, 0);
  296.   if (!NULL (val))
  297.     CHECK_STRING (val, 0);
  298.  
  299.   set_environment_alist (str, val);
  300.   return val;
  301. }
  302.  
  303.  
  304. syms_of_environ ()
  305. {
  306.   staticpro (&Venvironment_alist);
  307.   defsubr (&Ssetenv);
  308.   defsubr (&Sgetenv);
  309. }
  310.  
  311. init_environ ()
  312. {
  313.   Venvironment_alist = Qnil;
  314.   initialize_environment_alist ();
  315. }
  316.  
  317. #endif /* MAINTAIN_ENVIRONMENT */
  318.